home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Toolbox classes / PopupMenu < prev    next >
Text File  |  1998-02-10  |  2KB  |  98 lines
  1. \ Class PopupMenu.  This version handles pop-up menus in dialogs.
  2. \ If we ever need one somewhere else, we'll have to define a subclass
  3. \ with different HIT: and NORMAL: methods.
  4.  
  5. need    dialog+
  6.  
  7. forward    DRAWBOX
  8.  
  9. :proc  PUboxProc
  10.     i->l  drawbox   ;proc
  11.  
  12. from PopUpMenuMod  import{  POPUPMENU  }
  13.  
  14. compile: PopUpMenuMod
  15. true setInstall: PopUpMenuMod
  16.  
  17.  
  18. objPtr    THEMENU  class_is  PopUpMenu
  19.  
  20. : FIND-MENU  { link item# -- b }
  21.     BEGIN
  22.         link nilP = IF  false  exit  then
  23.         link -> theMenu
  24.         box#: theMenu  item#  =  IF  true  EXIT  THEN
  25.         F-link: theMenu  -> link
  26.     AGAIN  ;
  27.  
  28. :f  DRAWBOX  { dlg-hdl item# -- }
  29.         \  Called from the PROC that handles the user item
  30.         \ for a pop-up box.
  31.         \ item# is is the DIALOG item#, not the menu item#.
  32.     dlg-hdl  find-dlg  0EXIT
  33.     PUM-link: this_dlg  item#  find-menu   0exit
  34.     drawbox: theMenu   ;f
  35.  
  36. endload
  37.  
  38. \ TESTING:
  39.  
  40. \        ========= Pop-up Menus ===========
  41.  
  42.     2    PopUpMenu    PU1
  43.     3    PopUpMenu    PU2
  44.     3    PopUpMenu    PU3
  45.  
  46.  
  47. : MMM    ." menu hit" cr  ;
  48. : NNN    ." another menu hit!!" cr  ;
  49.  
  50. CFAS(    mmm mmm        )  1 5 7 init: PU1
  51. CFAS(    mmm mmm mmm    )  2 6 8 init: PU2
  52. CFAS(    nnn nnn nnn    )  3 4 5 init: PU3
  53.  
  54. : HPU1    hit: pu1  ;
  55. : HPU2    hit: pu2  ;
  56. : HPU3    cr ." pu3 hit!!"  hit: pu3  ;
  57.  
  58.  
  59. \        ========= Dialog boxes =========
  60.  
  61.     6    dialog+    D1
  62.     4    dialog+    D2
  63.  
  64. : QQQ        20 beep  ;
  65. : WWW         1 beep  ;
  66. : ZZZ        ." useritem hit" cr  ;
  67.  
  68.  
  69. : CLOSE1    close: d1  ;
  70. : CLOSE2    close: d2  ;
  71.  
  72. CFAS(    qqq www close1 togitem hpu1 hpu2    )   300 init: d1
  73. CFAS(    qqq www close2 hpu3                    )   301 init: d2
  74.  
  75.  
  76. : GO
  77.     " PMtest.rsrc" openresfile
  78.  
  79. \ Set up dialogs:
  80.  
  81.     +modeless
  82.     getnew: d1  getnew: d2
  83.  
  84. \ Set up pop-up menus:
  85.  
  86.     getnew: pu1  getnew: pu2  getnew: pu3
  87.  
  88. \ This part has to be done after GetNew: on the dialog(s)
  89.  
  90.     d1 link: pu1
  91.     d1 link: pu2
  92.     d2 link: pu3  ;
  93.     
  94.  
  95. : zz
  96.     close: d1  close: d2  -modeless
  97.     clear: menubar  draw: menubar  ;
  98.